home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 12 / BBS in a box XII-1.iso / Files / Tele / C / CutSize1.0a.sit / CutSize.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-04  |  7.0 KB  |  243 lines  |  [TEXT/TPAS]
  1. program CutSize1;
  2.  
  3. {$R-}               { Turn off range checking               }
  4. {$S+}               { Turn on Segmentation                  }
  5. {$I-}               { Turn off I/O error checking           }
  6. {$B+}
  7. {$R CUTSIZE.RSRC}
  8. {$T APPLmrak}       { Set application ID                    }
  9.  
  10.   uses Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf,SANE,PasPrinter;
  11.  
  12. Const
  13.     Junk    = '                                     ';
  14. type
  15.  Sections_typ       = record
  16.         Name        : string[25];
  17.         SecLev      : signedbyte;
  18.         Secmod      : signedbyte;
  19.         maxlen      : integer;
  20.         SecRest     : longint;
  21.         SecRestMod  : signedbyte;
  22.         Kind        : signedByte;
  23.         end;
  24.  
  25.  MessageFile_typ    = record
  26.         Location    : string[49];
  27.         LowMsg      : longint;
  28.         HiMsg       : longint;
  29.         SizeMsg     : longint;
  30.         Sections    : Array[1..255] of Sections_typ;
  31.         end;
  32.  
  33.  Flag_typ           = Array[0..7] of Boolean;
  34.  
  35.  Date_typ           = record
  36.         Month       : Signedbyte;
  37.         Day         : Signedbyte;
  38.         Year        : Signedbyte;
  39.         Hour        : signedbyte;
  40.         Minute      : signedbyte;
  41.         Second      : signedbyte;
  42.         end;
  43.  
  44.  MsgHdrFile_typ     = record
  45.         Status      : Signedbyte;
  46.         Reserved    : Signedbyte;
  47.         Number      : Longint;
  48.         Section     : Signedbyte;
  49.         Reserved2   : Signedbyte;
  50.         Delivery    : Date_typ;
  51.         From        : String[31];
  52.         ToWho       : String[31];
  53.         Subject     : String[41];
  54.         Network     : String[67];
  55.         Offset      : Longint;
  56.         MsgSize     : Longint;
  57.         ReplyNum    : Longint;
  58.         Original    : Date_typ;
  59.         end;
  60.  
  61. var
  62.     Messages    : file of MessageFile_Typ;
  63.     Mess        : MessageFile_Typ;
  64.     MsgHdr      : file of MsgHdrFile_typ;
  65.     Msg         : MsgHdrFile_typ;
  66.     Count       : Longint;
  67.     Totals      : Array[1..255] of Integer;
  68.     Wants       : Array[1..255] of Integer;
  69.     Needs       : Array[1..255] of Integer;
  70.     Total       : Longint;
  71.     Number      : Longint;
  72.     Astring     : Str255;
  73.     Position    : Longint;
  74.     KillLevel   : Longint;
  75.     Config      : Text;
  76.     OutFile     : Text;
  77.     Beginning   : Longint;
  78.     DeleteCount : Longint;
  79.     NewTotal    : Longint;
  80.     Deleted     : Longint;
  81.     MessagesF   : str255;
  82.     MsgHdrF     : Str255;
  83.     NewsF       : Str255;
  84.     OutFileF    : Str255;
  85.     LaunchF     : Str255;
  86.     TabbyLogF   : Str255;
  87.     Today       : String[10];
  88.  
  89. Procedure FindToday;
  90.     
  91.     var
  92.         Today1      : DateTimeRec;
  93.         Temp        : Str255;
  94.         Temp1      : Longint;
  95.  
  96.     Begin
  97.         GetTime(Today1);
  98.         Temp1 := Today1.Month;
  99.         NumToString(Temp1,Temp);
  100.         If Length(Temp) = 1 then Temp := Concat('0',Temp);
  101.         Today := Temp;
  102.         Temp1 := Today1.Day;
  103.         NumToString(Temp1,Temp);
  104.         If Length(Temp) = 1 then Temp := Concat('0',Temp);
  105.         Today := Concat(Today,'/',Temp,'/89');
  106.         end;
  107.         
  108.         
  109. Procedure Launchit (mode : integer;
  110.                                      fName : STR255);
  111.  
  112. INLINE
  113.    $204F, $A9F2;
  114.  
  115. begin
  116.     Reset(Config,'CutSize Config');
  117.     Readln(Config,MessagesF);
  118.     Readln(Config,MsgHdrF);
  119.     Readln(Config,NewsF);
  120.     ReadLn(Config,OutFileF);
  121.     Readln(Config,LaunchF);
  122.     For Count := 1 to 255 do begin
  123.         Readln(Config,Astring);
  124.         StringtoNum(Astring,Number);
  125.         Needs[Count]  := Number;
  126.         Totals[Count] := 0;
  127.         Wants[Count]  := 0;
  128.         end;
  129.     Close(Config);
  130.     DeleteCount := 0;
  131.     Deleted := 0;
  132.     NewTotal := 0;
  133.     Total := 0;
  134.     KillLevel := 80;
  135.     Reset(Config,NewsF);
  136.     Readln(Config,Astring);
  137.     Close(Config);
  138.     StringtoNum(Astring,Beginning);
  139.     Reset(Messages,MessagesF);
  140.     Read(Messages,Mess);
  141.     Close(Messages);
  142.     FindToday;
  143.     Writeln('___');
  144.     Writeln('|*| CutSize 1.0 - by mark kupferman (1:101/470)');
  145.     Writeln;
  146.     Writeln(Today);
  147.     Writeln;
  148.     Writeln('Scanning Message Base...');
  149.     Writeln;
  150.     ReWrite(OutFile,OutFileF);
  151.     Writeln(Outfile,'CutSize 1.0 - by Mark Kupferman     Daily Report of Message Activity for ',Today);
  152.     Writeln(Outfile,'');
  153.     
  154.     Reset(MsgHdr,MsgHdrF); 
  155.     Repeat
  156.         Count := Count + 1;
  157.         Read(MsgHdr,Msg);
  158.         If Msg.Status <> 1 then Totals[Msg.Section] := Totals[Msg.Section] + 1;
  159.         If Msg.Status = 1 then Deleted := Deleted + 1;
  160.         total := total + 1;
  161.         If Msg.Number > Beginning then begin
  162.             Wants[Msg.Section] := Wants[Msg.Section] + 1;
  163.             NewTotal := NewTotal + 1;
  164.             end;
  165.         Until eof(MsgHdr);
  166.     Close(MsgHdr);
  167.     
  168.     Writeln(OutFile);
  169.     Writeln(OutFile);
  170.     Writeln(Outfile,'Number of new messages added - by section:');
  171.     Writeln(OutFile);
  172.     For Count := 1 to 255 do begin
  173.         If Wants[Count] <> 0 then Begin
  174.             Writeln(OutFile,Mess.Sections[Count].Name,chr(9),' = ',Wants[Count]);
  175.             end;
  176.         end; 
  177.     Writeln(OutFile,'');
  178.     Writeln(Outfile,'Total # of new messages : ',NewTotal);
  179.     Writeln(Outfile,'Total # of messages     : ',Total);
  180.     Writeln(Outfile,'Total # of dead messages: ',Deleted);
  181.     Writeln(Outfile);
  182.     Writeln;
  183.     Writeln;
  184.     Writeln('Deleting Overflow Messages...');
  185.     Writeln;
  186.     Writeln('    "S" = Saving Message');
  187.     Writeln('    "D" = Deleting Message');
  188.     Writeln('    "." = Already Deleted Message');
  189.     Writeln;
  190.     For Count := 1 to 255 do begin
  191.         Wants[Count] := 0;
  192.         end;
  193.     Reset(MsgHdr,MsgHdrF);
  194.     Count := 0;
  195.     Repeat
  196.         Count := Count + 1;
  197.         Position := FilePos(Msghdr);
  198.         Read(MsgHdr,Msg);
  199.         If Msg.Status = 1 then Write('.');
  200.         If Msg.Status <> 1 then begin
  201.             If Totals[Msg.Section] <=Needs[Msg.Section] then begin
  202.                 Write('S');
  203.                 end;
  204.             If Totals[Msg.Section] >Needs[Msg.Section] then begin 
  205.                 Msg.Status:=1;
  206.                 Seek(MsgHdr,Position);
  207.                 Write(MsgHdr,Msg);
  208.                 Totals[Msg.Section] := Totals[Msg.Section]-1;
  209.                 Write('D');
  210.                 Wants[Msg.Section] := Wants[Msg.Section]+1;
  211.                 DeleteCount:= DeleteCount+1;
  212.                 end;
  213.             end;
  214.         Until eof(MsgHdr);
  215.     Close(MsgHdr);
  216.     Writeln;
  217.     Writeln(OutFile);
  218.     Writeln(Outfile,'Number of deleted messages - by section:');
  219.     Writeln(OutFile);
  220.     For Count := 1 to 255 do begin
  221.         If Wants[Count] <> 0 then Begin
  222.             Writeln(OutFile,Mess.Sections[Count].Name,chr(9),' = ',Wants[Count]);
  223.             end;
  224.         end; 
  225.     Writeln(OutFile,'');
  226.     Writeln(Outfile,'Total # of deleted messages : ',DeleteCount);
  227.     Writeln(Outfile);
  228.     Writeln(Outfile);
  229.     Writeln(Outfile,'Total number of messages in each base:');
  230.     Writeln(Outfile);
  231.     Writeln;
  232.     For Count := 1 to 255 do begin
  233.         If Mess.Sections[Count].Kind <> 0 then Begin
  234.             Writeln(Outfile,Mess.Sections[Count].Name,chr(9),' = ',Totals[Count]);
  235.             end;
  236.         end; 
  237.     Writeln(OutFile);
  238.     Writeln(Outfile);
  239.     Writeln;
  240.     Close(Outfile);
  241.     GetIndString(Astring,0,4);
  242.     Launchit(0,LaunchF);
  243. end.